home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
BYTECOMM.ARJ
/
COMM.BAS
next >
Wrap
BASIC Source File
|
1991-07-19
|
3KB
|
118 lines
REM A *very* simple communications program in interpreted Basic.
REM Receives files via XMODEM.
REM
10 CLS
20 DEFINT A-Z : KEY OFF
30 FALSE=0
40 TRUE=1
50 XOFF$=CHR$(19)
60 XON$=CHR$(17)
70 LF$=CHR$(10)
80 BKSPC$=CHR$(8)
90 CTRLR$=CHR$(18)
100 CTRLZ$=CHR$(26):CTRLX$=CHR$(24)
110 EOT$=CHR$(4):NAK$=CHR$(21):ACK$=CHR$(6):SOH$=CHR$(1)
120 OPEN "COM1:1200,N,8,1" AS 1
130 PRINT "A simple, XMODEM-capable communications program"
140 PRINT
150 PRINT "Press Ctrl-R when instructed to start an XMODEM receive operation."
160 PRINT "Press Ctrl-Z to end the program."
170 PRINT
180 INPUT "Want the modem to dial the number? (Y or N) ", DIAL$
190 IF DIAL$ = "y" OR DIAL$ = "Y" THEN GOTO 210
200 GOTO 260
210 INPUT "Telephone number to dial? ", PHONE$
220 INPUT "Touch-tone or rotary dial? (T or R) ",ROTARY$
230 PREFIX$ = "ATD"
240 IF ROTARY$ = "T" OR ROTARY$ = "t" THEN PREFIX$ = "ATDT"
250 PRINT #1, PREFIX$+PHONE$
260 LOCATE ,,1
270 B$=INKEY$:IF B$="" THEN GOTO 320
280 IF LEN(B$)<>1 THEN GOTO 320
290 IF B$ = CTRLR$ THEN GOTO 590
300 IF B$ = CTRLZ$ THEN GOTO 510
310 PRINT #1,B$;
320 IF EOF(1) THEN 260
330 IF LOC(1)>128 THEN PAUSE=TRUE:PRINT#1,XOFF$;
340 ON ERROR GOTO 370
350 A$=INPUT$(LOC(1),#1)
360 GOTO 380
370 RESUME
380 ON ERROR GOTO 0
390 FOR I=1 TO LEN(A$)
400 C$=MID$(A$,I,1)
420 IF C$<>BKSPC$ THEN GOTO 450
430 IF POS(0)=1 THEN GOTO 470
440 LOCATE ,POS(0)-1,1:PRINT " ";:LOCATE ,POS(0)-1,1:GOTO 470
450 IF ASC(C$)>127 THEN C$=CHR$(ASC(C$)-128)
460 IF C$<>LF$ THEN PRINT C$;
470 NEXT I
480 IF LOC(1)>0 THEN 260
490 IF PAUSE THEN PAUSE=FALSE:PRINT#1,XON$;
500 GOTO 260
510 REM End the program.
520 PRINT
530 INPUT "Are you sure you want to quit? (Y or N) ", C$
540 IF C$ = "y" OR C$ = "Y" THEN GOTO 570
550 PRINT
560 GOTO 320
570 CLOSE
580 END
590 REM Do an XMODEM receive.
600 INPUT "Filename to create on the PC? ", FIL$
610 IF FIL$ = "" THEN GOTO 740
620 OPEN FIL$ AS #2 LEN=128
630 FIELD 2, 128 AS DBLOCK$
640 PRINT #1, NAK$;
650 A$="":BLKCNT=1:BCOUNT=1:BLOCK$=""
660 WHILE BLOCK$ <> EOT$ AND ABORT <> TRUE
670 BLOCK$=""
680 GOSUB 790
690 WEND
700 IF ABORT = TRUE THEN GOTO 750
710 PRINT
720 PRINT "File ";FIL$;" has been received."
730 PRINT
740 GOTO 260
750 PRINT
760 PRINT "Reception of ";FIL$;" cancelled."
770 PRINT
780 GOTO 740
790 REM
800 B$=INKEY$:IF B$="" THEN GOTO 850
810 IF B$<>CTRLX$ THEN GOTO 850
820 PRINT #1,CTRLX$;CTRLX$;
830 ABORT=TRUE
840 GOTO 1060
850 IF EOF(1) THEN GOTO 790
860 A$=INPUT$(LOC(1),#1)
870 BLOCK$=BLOCK$+A$
880 IF LEN(BLOCK$)=1 AND BLOCK$=EOT$ THEN GOTO 1110
890 IF LEN(BLOCK$) < 132 THEN GOTO 790
900 IF LEN(BLOCK$) <> 132 THEN GOTO 1070
910 IF LEFT$(BLOCK$, 1) <> SOH$ THEN GOTO 1070
920 IF ASC(MID$(BLOCK$, 2, 1)) <> BLKCNT THEN GOTO 1070
930 D$=MID$(BLOCK$,4,128)
940 CHKSUM=ASC(MID$(BLOCK$,132,1))
950 CNUM=0
960 FOR I=1 TO 128
970 CNUM=CNUM+ASC(MID$(D$,I,1))
980 NEXT I
990 IF (CNUM AND 255) <> CHKSUM THEN GOTO 1070
1000 PRINT #1, ACK$;
1010 PRINT "Block ";BCOUNT; " received ok."
1020 LSET DBLOCK$=D$
1030 PUT #2
1040 BLKCNT = 255 AND (BLKCNT + 1)
1050 BCOUNT = BCOUNT + 1
1060 RETURN
1070 PRINT #1, NAK$;
1080 PRINT "Error occurred in block "; BCOUNT; ". Correcting for it."
1090 BLOCK$=""
1100 GOTO 790
1110 CLOSE #2
1120 A$=EOT$
1130 PRINT #1, ACK$;
1140 GOTO 1060